home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
rotatel
/
rotatel.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
3KB
|
128 lines
unit Rotatel;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
StdCtrls, Menus;
type
TRotateLabel = class(TCustomLabel)
private
fAngle: longint;
fDegToRad, fCosAngle, fSinAngle: double;
procedure SetAngle(Value: longint);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Angle: longint read fAngle write SetAngle default 0;
{property Align;}
{property Alignment;}
{property AutoSize;}
property Caption;
property Color;
property DragCursor;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent default true;
property Visible;
{property WordWrap; }
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TRotateLabel]);
end;
constructor TRotateLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fAngle := 0;
fDegToRad := PI / 180;
fCosAngle := 1; {cos(fAngle * fDegToRad)}
fSinAngle := 0; {sin(fAngle * fDegToRad)}
Transparent := true;
AutoSize := false;
end;
procedure TRotateLabel.SetAngle(Value: longint);
begin
if fAngle <> Value then
begin
fAngle := Value;
fCosAngle := cos(fAngle * fDegToRad);
fSinAngle := sin(fAngle * fDegToRad);
Invalidate;
end;
end;
procedure TRotateLabel.Paint;
var
LogRec: TLOGFONT;
OldFont,
NewFont: HFONT;
midX, midY, H, W, X, Y: integer;
P1, P2, P3, P4: TPoint;
begin
with Canvas do
begin
Font := Self.Font;
Width := TextWidth(Caption + ' ');
Height := Width;
midX := Width div 2;
midY := Height div 2;
Brush.Style := bsClear;
GetObject(Font.Handle, SizeOf(LogRec), @LogRec);
LogRec.lfEscapement := fAngle*10;
LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
NewFont := CreateFontIndirect(LogRec);
OldFont := SelectObject(Canvas.Handle,NewFont);
W := TextWidth(Caption);
H := TextHeight(Caption);
X := midX - trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
Y := midY + trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
if not Transparent then
begin
W := W+7; H := H+5;
P1.X := midX - trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
P1.Y := midY + trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
P2.X := midX + trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
P2.Y := midY - trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
P3.X := midX + trunc(W/2*fCosAngle) + trunc(H/2*fSinAngle);
P3.Y := midY - trunc(W/2*fSinAngle) + trunc(H/2*fCosAngle);
P4.X := midX - trunc(W/2*fCosAngle) + trunc(H/2*fSinAngle);
P4.Y := midY + trunc(W/2*fSinAngle) + trunc(H/2*fCosAngle);
Brush.Color := Self.Color;
Brush.Style := bsSolid;
Polygon([P1, P2, P3, P4]);
end;
TextOut(X, Y, Caption);
NewFont := SelectObject(Canvas.Handle,OldFont);
DeleteObject(NewFont);
end;
end;
end.